perm filename PTMOVF.OLD[MSS,LCS] blob
sn#169958 filedate 1975-07-21 generic text, type T, neo UTF8
00100 TITLE MSSIO ; ********* JUN 8,74 *********
00200 ;; INTERNAL GETFI2,FASTI2,LOOP
00205 INTERNAL GETFI2,FASTI2
00210 INTERNAL LOOK,LOOKD,LOOKF,PAC,UNPAC
00300
00400
00500 CH3←15 ;WAS ←13 4/18/75 *******
00600
00700 DEFINE ERROR (MSG)
00800 < JSA 16,.ERROR
00900 JUMP [ASCIZ/MSG/
01000 ]
01100 >
01200
01500 ;CALL GETFI2(<FILE>)
01600
01700 GETFI2: 0
01800 MOVE 0,@0(16)
01900 MOVEM 0,FILNAM
02000 JSA 16,INTFIZ
02100 MOVE 0,[SIXBIT/DMD/]
02200 MOVEM 0,DIR+1
02300 JSA 16,LKUP
02400 SKIPA
02500 JRST GETF3
02600 SETZM DIR+1
02700 JSA 16,LKUP
02800 0
02900 GETF3: JRA 16,1(16)
03000
03100 LKUP: 0
03200 SETZM DIR+2
03300 SETZM DIR+3
03400 LOOKUP CH3,DIR
03500 JRA 16,0(16)
03600 JRA 16,1(16)
03700
03800 INTFIZ: 0 ;INITS DSK FOR INPUT
03900 MOVEI REGS
04000 BLT REGS+3
04100 INIT CH3,17
04200 SIXBIT/DSK/
04300 0
04400 ERROR <CAN'T INIT DSK!>
04500 JRST INTF4
04600
04900
05000 ;CALL FASTI2(<ARRAY>,<NO. WORDS>)
05100
05200 FASTI2: 0
05300 HRRZ 0,0(16)
05400 SUBI 0,1
05500 MOVEM 0,COM
05600 MOVN 0,@1(16)
05700 HRLM 0,COM
05800 INPUT CH3,COM
05900 STATZ CH3,740000
06000 0
06100 JRA 16,2(16)
06200
06300 COM: OCT 0,0
06400 BLKNUM: 0
08200
08300 .ERROR: 0
08400 OUTSTR [ASCIZ/?
08500 /] ;MAKE SURE HE CAN SEE HIS ERROR
08600 OUTSTR @(16) ;OUTPUT ERROR MESSAGE
08700 CALLI 1,12 ;LET USER CONTI2UE
08800 JRA 16,1(16)
00300
00400 CH←13
00500
00600 REGS: BLOCK 20
00700
00800 ;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
00900
01000 LOOKF: 0
01100 MOVSI 0,'DMD'
01200 JRST LOOK1
01300 LOOKD: 0
01400 MOVSI 0,'DAT'
01500 JRST LOOK1
01600 LOOK: 0
01700 MOVEI 0,0
01800 LOOK1: MOVEM 0,DIR+1
01900 MOVE 0,@(16)
02000 MOVEM 0,FILNAM
02100 JSA 16, INTFIQ
02200 SETZM DIR+2
02300 SETZM DIR+3
02400 LOOKUP CH,DIR
02500 TDZA 0,0
02600 MOVNI 0,1
02700 JRA 16,1(16)
02800
02900 INTFIQ: 0 ;INITS DSK FOR INPUT
03000 MOVEI REGS
03100 BLT REGS+3
03200 INIT CH,17
03300 SIXBIT/DSK/
03400 0
03500 HALT .-3
03600 ; ERROR <CAN'T INIT DSK!>
03700
03800 INTF4: MOVE 0,FILNAM#
03900 MOVEM 0,FN#
04000 MOVE 1,[POINT 7,FN]
04100 INTF3: MOVE 2,[POINT 6,DIR]
04200 SETZM DIR
04300 MOVEI 3,5
04400 INTF1: ILDB 0,1
04500 CAIN 0," "
04600 JRST INTF2
04700 SUBI 0,40
04800 IDPB 0,2
04900 SOJG 3,INTF1
05000 INTF2: HRLZI REGS
05100 BLT 3
05200 JRA 16,0(16)
05300
05400 DIR: BLOCK 4
05500
05600
05700 PAC: 0 ;CALL PAC(PW,AR)
05800 HRRZ 4,1(16) ; ******* USES AC'S 4,5,6 ********
05900 ADDI 4,2
06000 HRR 5,@4 ;SIZE IS 12 BITS
06100 LSHC 5,-10
06200 SOJ 4,
06300 HRR 5,@4
06400 LSHC 5,-16
06500 SOJ 4,
06600 HRR 5,@4
06700 LSHC 5,-16
06800 MOVEM 6,@0(16)
06900 JRA 16,2(16)
07000 UNPAC: 0 ;CALL UNPAC(PW,AR)
07100 HRRZ 1,1(16)
07200 ADDI 1,2
07300 MOVE 2,@0(16)
07400 LSHC 2,-10 ; 14 BITS, 14 BITS, 8 BITS
07500 ASH 3,-34
07600 MOVEM 3,@1
07700 SOJ 1,
07800 LSHC 2,-16
07900 ASH 3,-26
08000 MOVEM 3,@1
08100 SOJ 1,
08200 LSHC 2,-16
08300 ASH 3,-26
08400 MOVEM 3,@1
08500 JRA 16,2(16)
08550
08700
08800 ; SUBROUTINE LOOP(I,J,K,L,M,N)
08900 ; DIMENSION N(1)
09000 ; DO 1 NN=I,J,K
09100 ;1 N(NN+L)=N(NN+M)
09200 ; END
09300
09400 ;;LOOP: 0
09500 ;; MOVE 4,@1(16)
09600 ;; MOVE 3,@0(16)
09700 ;; SUB 4,3
09800 ;; HRRZ 2,5(16)
09900 ;; SOJ 2,
10000 ;; ADD 2,3
10100 ;; JUMPL 4,MIMI
10200 ;; HRR 5,2
10300 ;; ADD 5,@3(16)
10400 ;; ADD 4,2
10500 ;; ADD 4,@3(16)
10600 ;; ADD 2,@4(16)
10700 ;; HRL 5,2
10800 ;; BLT 5,(4)
10900 ;; JRA 16,6(16)
11000 ;;MIMI: HRR 5,@4(16)
11100 ;; HRRM 5,XN
11200 ;; HRR 5,@3(16)
11300 ;; HRRM 5,XN+1
11400 ;;XN: MOVE 6,(2)
11500 ;; MOVEM 6,(2)
11600 ;; SOJ 2,
11700 ;; AOJL 4,XN
11800 ;; JRA 16,6(16)
12000 ;; TITLE MOVE
12100 ENTRY GETPTS,MOVIT,OUTLIM,EXTEN,SORT2
12200 EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD|
12300
12400 K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
12500 DEFINE FIXX(N)
12600 < JUMPGE N,.+5
12700 MOVNS N
12800 FIX N,233000
12900 MOVNS N
13000 CAIA
13100 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
13200
13300 ; SUBROUTINE GETPTS
13400 ; DIMENSION N(500),NP(500)
13500 ; COMMON/XRN/RN(4000) /KJY/ K,J
13600 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
13700 ; 1/PTR/PWDS(250),ITEM,LL,I,IX
13800 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
13900 ; 1,(R6,RJQ(4)),(N,RN(2500)),(NP,RN(3000))
14000
14100 GETPTS: 0 ;CALL GETPTS(N)
14200 SETZ J, ; J=0
14300 SETZ K, ; K=0
14400 MOVE JJ2,POSI+=8
14500 MOVE R2,.COMM.
14600 ;; SETZ X,
14700 MOVE X,@(16)
14800 SOS X
14900 MOVEI M,PTR ; DO 1 M=1,ITEM
15000 ADDI M,(X)
15100 G1: AOJ X,
15200 MOVE L,(M)
15300 FIXX(L)
15400 MOVEI R,XRN ;L=PWDS(M)
15500 ADDI R,(L) ;IF(RTLINE(L))GO TO 1
15600 MOVE 1,1(R) ;RN(L+2)
15700 CAML R2,[=5.0]
15800 JRST GZ
15900 CAME R2,1
16000 JRST GX
16100 GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
16200 JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
16300 CAME A,(R)
16400 JRST GX
16500 ; CHECK CODE NUM
16600 G9: MOVE A,2(R) ;IF(R6.NE.RY)GO TO 1
16700 CAMLE A,.COMM.+6
16800 JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
16900 CAMGE A,.COMM.+5 ;R4
17000 JRST G2
17100
17200 SKIPG JJ2
17300 MOVE JJ2,X
17400 AOJ J,
17500 ; IN LIMITS?
17600 MOVEI A,XRN+=2498 ;J=J+1
17700 ADDI A,(J)
17800 MOVEI 0,(L)
17900 AOJ K, ;K=K+1
18000 MOVEI 1,XRN+=2998
18100 ADDI 1,(K) ;NP(K)=L
18200 MOVEM 0,(1)
18300 ADDI 0,3 ;N(J)=L+3
18400 MOVEM 0,(A)
18500 ; NP IS FOR USE IN JUSTIFY ROUTINE
18600 G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
18700 CAMGE RY,[=4.0]
18800 JRST GX
18900 CAMLE RY,[=7.0]
19000 JRST GX ;IF(RY.GT.7)GO TO 1
19100 ; TWO-ENDED ITEM?
19200 MOVE RZ,-1(R) ;RZ=RN(L)
19300 ; WD CNT
19400 CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
19500 JRST G4
19600 CAMN RY,[=5.0]
19700 JRST G5
19800 CAMN RY,[=6.0]
19900 JRST G6
20000 CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
20100 JRST G5 ; THERE IS A TRILL WIGGLE
20200 JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
20300 G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
20400 JRST GX
20500 JRST G5 ;GO TO 1
20600 G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
20700 JRST G8
20800 ;; MOVEI 1,XRN ;IF(RN(L+10).LT.30)GO TO 8
20900 ;; ADDI 1,(L)
21000 ;; MOVE 1,11(1)
21100 MOVE 1,=9(R)
21200 CAMGE 1,[=30.0]
21300 JRST G8
21400 MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
21500 CAMLE A,.COMM.+6
21600 JRST G8
21700 CAMGE A,.COMM.+5
21800 JRST G8
21900 SKIPG JJ2
22000 MOVE JJ2,X
22100 AOJ J,
22200 ; IN LIMITS?
22300 MOVEI A,XRN+=2498 ;J=J+1
22400 ADDI A,(J)
22500 MOVEI 0,(L) ;J=J+1
22600 ADDI 0,=8 ;N(J)=L+8
22700 MOVEM 0,(A)
22800 G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
22900 JRST G5
23000 MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
23100 JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
23200 MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
23300 JUMPN A,G8B
23400 CAMGE RZ,[=8.0]
23500 JRST G5 ;IF(RZ.LT.8)GO TO G5
23600 MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
23700 JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
23800 G8B: MOVE A,8(R)
23900 CAMLE A,.COMM.+6
24000 JRST G5
24100 CAMGE A,.COMM.+5 ;R4
24200 JRST G5
24300
24400 SKIPG JJ2
24500 MOVE JJ2,X
24600 AOJ J, ;J=J+1
24700 ; IN LIMITS?
24800 MOVEI A,XRN+=2498 ;J=J+1
24900 ADDI A,(J)
25000 MOVEI 0,(L)
25100 ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
25200 MOVEM 0,(A) ;N(J)=L+9
25300 G5: MOVE A,5(R)
25400 CAMLE A,.COMM.+6
25500 JRST GX
25600 CAMGE A,.COMM.+5 ;R4
25700 JRST GX
25800
25900 SKIPG JJ2
26000 MOVE JJ2,X
26100 AOJ J,
26200 ; IN LIMITS?
26300 MOVEI A,XRN+=2498 ;J=J+1
26400 ADDI A,(J)
26500 MOVEI 0,(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
26600 ADDI 0,6 ;N(J)=L+6
26700 MOVEM 0,(A)
26800 GX: CAMGE X,PTR+=250 ;1 CONTINUE
26900 AOJA M,G1
27000 MOVEM JJ2,POSI+=8
27100 MOVEM J,KJY+1
27200 MOVEM K,KJY
27300 JRA 16,1(16)
27400
27500 ; SUBROUTINE MOVIT
27600 ; DIMENSION N(500)
27700 ; COMMON/XRN/RN(4000) /KJY/ DONT,J
27800 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
27900 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
28000 ; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
28100 MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
28200 MOVE R,.COMM.+=10
28300 FSBR R,.COMM.+=9
28400 MOVE RY,.COMM.+6
28500 FSBR RY,.COMM.+5
28600 FDVR R,RY
28700 MOVEI L,XRN+=2499 ; DO 1 K=1,J
28800 SETZ K,
28900 MOVE 0,.COMM.+=10 ; SET UP R9
29000 M1: MOVE X,L ; L=N(K)
29100 MOVE A,(X)
29200 MOVEI R2,XRN ;RA=RN(L)
29300 ADDI R2,(A)
29400 MOVEI RZ,(R2)
29500 MOVE R2,-1(R2)
29600 CAMGE R2,.COMM.+5 ;IF(OUTLIM(R4,R5,RA))GO TO 1
29700 JRST MX
29800 CAMLE R2,.COMM.+6
29900 JRST MX
30000 JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
30100 FSBR R2,.COMM.+5
30200 FMPR R2,R
30300 M2: FADR R2,.COMM.+=9 ; RN(L)=R8+RA
30400 MOVEM R2,-1(RZ)
30500 MX: AOJ K, ;1 CONTINUE
30600 CAMGE K,KJY+1
30700 AOJA L,M1
30800 JRA 16,(16)
30900
31000 OUTLIM: 0 ; FUNCTION OUTLIM(I,J)
31100 SETO 0, ; OUTLIM=-1
31200 MOVE 4,.COMM.+5 ; IF(RN(I+J).LT.R4)RETURN
31300 MOVEI 2,XRN
31400 ADD 2,@(16)
31500 ADD 2,@1(16)
31600 CAMLE 4,-1(2)
31700 JRA 16,2(16)
31800 MOVE 5,.COMM.+6 ; IF(RN(I+J).GT.R5)RETURN
31900 CAMGE 5,-1(2)
32000 JRA 16,2(16)
32100 SETZ 0, ; OUTLIM=0
32200 JRA 16,2(16)
32300
32400
32500 SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
32600 MOVEI 2,2 ;DIMENSION RPOS(2,200)
32700 S3: MOVE 6,2 ;(K=L HERE)
32800 SETO 11, ;L=2
32900 HRRZI 3,@(16) ;3 J=-1
33000 MOVE 4,2 ;RX=RPOS(1,L-1)
33100 SUBI 4,1 ;L-1
33200 IMULI 4,2
33300 ADDI 4,(3)
33400 MOVE 5,-2(4) ;RX
33500 S2: MOVE 7,6 ; DO 2 K=L,M
33600 ;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
33700 IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
33800 ADDI 7,(3)
33900 CAMG 5,-2(7)
34000 JRST S1 ; CONTINUE
34100 MOVE 5,-2(7) ; RX=RPOS(1,K)
34200 ;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
34300 MOVE 11,6 ;J=K
34400 S1: CAMGE 6,@1(16) ;2 CONTINUE
34500 AOJA 6,S2
34600 JUMPL 11,S4 ;IF(J)GO TO 4
34700 MOVE 12,2 ;K=L-1
34800 SOS 12
34900 IMULI 12,2 ;(K*2)
35000 ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
35100 MOVE 10,-2(12)
35200 ;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
35300 IMULI 11,2
35400 ADD 11,3
35500 EXCH 10,-2(11)
35600 MOVEM 10,-2(12)
35700 MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
35800 EXCH 10,-1(11)
35900 MOVEM 10,-1(12)
36000 S4: CAMGE 2,@1(16) ;4 L=L+1
36100 AOJA 2,S3 ;IF(L.LE.M)GO TO 3
36200 JRA 16,2(16) ;END
36300
36400 EXTEN: 0 ;FUNCTION EXTEN(X)
36500 HRRM 16,.+2
36600 JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
36700 JUMP @0
36800 JUMP [=1.0]
36900 FMPR [=10.0]
37000 JRA 16,1(16)
37100
37200 END